Pregunta 1: [10 puntos] En este ejercicio vamos a usar la tabla de datos wine.csv, que contiene variantes del vino “Vinho Verde”. Los datos incluyen variables de pruebas fisicoquímicas y sensoriales realizadas a dicho vino.

La tabla contiene 1599 filas y 12 columnas, las cuales se explican a continuación.

Para esto realice lo siguiente:

1. Cargue la tabla de datos wine.csv en R.

datos <- read.table("../datos/wine.csv", sep = ",", dec = ".", header = T, stringsAsFactors = T)

2. Usando el comando sample de R genere al azar una tabla de testing con una 20 % de los datos y con el resto de los datos genere una tabla de aprendizaje.

filas <- dim(datos)[1] 
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]

3. Use el método de los SVM con traineR para generar un modelo predictivo para la tabla de aprendizaje. Pruebe con todos los kernel (núcleos) linear, polynomial, radial basis y sigmoid hasta encontrar el que minimiza el error global.

Linear

library(traineR)

modelo.linear <- train.svm(tipo~., data = taprendizaje, kernel = "linear")
prediccion.linear <- predict(modelo.linear, ttesting , type = "class")

MC.Linear <- confusion.matrix(ttesting, prediccion.linear)
linear <- general.indexes(mc = MC.Linear)
linear

Confusion Matrix:
        prediction
real     blanco tinto
  blanco    968     6
  tinto       5   320

Overall Accuracy: 0.9915
Overall Error:    0.0085

Category Accuracy:

       blanco        tinto
     0.993840     0.984615

Polynomial

modelo.polynomial <- train.svm(tipo~., data = taprendizaje, kernel = "polynomial")
prediccion.polynomial <- predict(modelo.polynomial, ttesting , type = "class")
MC.polynomial <- confusion.matrix(ttesting, prediccion.polynomial)
polynomial <- general.indexes(mc = MC.polynomial)
polynomial

Confusion Matrix:
        prediction
real     blanco tinto
  blanco    971     3
  tinto      11   314

Overall Accuracy: 0.9892
Overall Error:    0.0108

Category Accuracy:

       blanco        tinto
     0.996920     0.966154

Radial

modelo.radial <- train.svm(tipo~., data = taprendizaje, kernel = "radial")
prediccion.radial <- predict(modelo.radial, ttesting , type = "class")
MC.radial <- confusion.matrix(ttesting, prediccion.radial)
radial <- general.indexes(mc = MC.radial)
radial

Confusion Matrix:
        prediction
real     blanco tinto
  blanco    972     2
  tinto       5   320

Overall Accuracy: 0.9946
Overall Error:    0.0054

Category Accuracy:

       blanco        tinto
     0.997947     0.984615

Sigmoid

modelo.sigmoid <- train.svm(tipo~., data = taprendizaje, kernel = "sigmoid")
prediccion.sigmoid <- predict(modelo.sigmoid, ttesting , type = "class")
MC.sigmoid <- confusion.matrix(ttesting, prediccion.sigmoid)
sigmoid <- general.indexes(mc = MC.sigmoid)
sigmoid

Confusion Matrix:
        prediction
real     blanco tinto
  blanco    960    14
  tinto      20   305

Overall Accuracy: 0.9738
Overall Error:    0.0262

Category Accuracy:

       blanco        tinto
     0.985626     0.938462

4. Usando Redes Neuronales con el paquete traineR genere un modelo predictivo para la tabla de aprendizaje. Pruebe modificar los parámetros del método hasta encontrar el que minimiza el error global.

modelo.nnet <- train.nnet(tipo~. , data = taprendizaje, size = 4, maxit = 1000)
# weights:  57
initial  value 2829.967964 
iter  10 value 1279.367965
iter  20 value 1117.955469
iter  30 value 912.086786
iter  40 value 719.590137
iter  50 value 644.233256
iter  60 value 602.213161
iter  70 value 338.275865
iter  80 value 242.861597
iter  90 value 218.549134
iter 100 value 195.120847
iter 110 value 180.507667
iter 120 value 178.636968
iter 130 value 177.633015
iter 140 value 176.739880
iter 150 value 176.333398
iter 160 value 175.581406
iter 170 value 175.139990
iter 180 value 174.437987
iter 190 value 174.002733
iter 200 value 173.846150
iter 210 value 173.329150
iter 220 value 169.486473
iter 230 value 163.371421
iter 240 value 163.100541
final  value 163.099746 
converged
prediccion.nnet <- predict(modelo.nnet, ttesting, type = "class")

MC.nnet <- confusion.matrix(ttesting,prediccion.nnet)

redesNeuronales <- general.indexes(mc=MC.nnet)
redesNeuronales

Confusion Matrix:
        prediction
real     blanco tinto
  blanco    969     5
  tinto      17   308

Overall Accuracy: 0.9831
Overall Error:    0.0169

Category Accuracy:

       blanco        tinto
     0.994867     0.947692

5. Construya un DataFrame de manera que en cada una de las filas aparezca un modelo predictivo y en las columnas aparezcan los índices Precisión Global, Error Global, Precisión Positiva (PP), Precisión Negativa (PN), Falsos Positivos (FP), los Falsos Negativos (FN), la Asertividad Positiva (AP) y la Asertividad Negativa (AN). ¿Cuál de los modelos es mejor para estos datos? (incluya todos los métodos que hemos estudiando en el curso).

library(dplyr)

precisiones <- rbind(as.data.frame(Confusion(linear$confusion.matrix)),as.data.frame(Confusion(polynomial$confusion.matrix)),as.data.frame(Confusion(radial$confusion.matrix)),as.data.frame(Confusion(sigmoid$confusion.matrix)),as.data.frame(Confusion(redesNeuronales$confusion.matrix)))


tablaC <- read.table("Tabla Comparativa wine2.csv",dec = ".",sep = "," , header = T)

tablaC <- rbind(precisiones,tablaC)

rownames(tablaC) <- c("SVM.linear","SVM.polynomial","SVM.radial","SVM.sigmoid","Redes Neuronales","Árboles de Decisión", "Bosques Aleatorios", "ADA Boosting", "XG Boosting","KNN.rectangular", "KNN.triangular", "KNN.epanechnikov", "KNN.biweight", "KNN.triweight", "KNN.cos",
"KNN.inv", "KNN.gaussian","KNN.optimal")



tablaC %>%
  arrange(desc(Precision.Global))
write.csv(tablaC,"Tabla Comparativa wine3.csv", row.names = FALSE)
tablaC

El modelo con la mejor Precisión Global fue KNN con kernel inv. Debido a que la Precisión Negativa y Precisión Positiva es bastante buena nos quedamos con este como el mejor modelo.

Pregunta 2: [10 puntos] Suponga que somos contratados por el banco y se nos pide volver a predecir el monto promedio de deuda en tarjeta de crédito de una cartera de clientes relativamente nuevos, basado en otra cartera de comportamiento y estructura similar de la cual sí se tiene información de deuda en tarjeta de crédito. En este ejercicio hacemos uso de la tabla de datos DeudaCredito.csv que contiene información de los clientes en una de las principales carteras de crédito del banco, e incluye variables que describen cada cliente tanto dentro del banco como fuera de este.

Cargue la tabla de datos en R, asegúrese que las variables se están leyendo de forma correcta. Recodifique variables en caso de que sea necesario, tome para entrenamiento un 80 % de la tabla de datos. Realice lo siguiente:

library(fastDummies)

datos <- read.table("../datos/DeudaCredito.csv", dec = ".", sep = ",", header = T, stringsAsFactors = T )[,-1]

datos <- dummy_cols(datos, select_columns = c("Genero","Estudiante","Casado","Etnicidad"),remove_selected_columns = T)
str(datos)
'data.frame':   400 obs. of  16 variables:
 $ Ingreso                   : num  14.9 106 104.6 148.9 55.9 ...
 $ Limite                    : int  3606 6645 7075 9504 4897 8047 3388 7114 3300 6819 ...
 $ CalifCredit               : int  283 483 514 681 357 569 259 512 266 491 ...
 $ Tarjetas                  : int  2 3 4 3 2 4 2 2 5 3 ...
 $ Edad                      : int  34 82 71 36 68 77 37 87 66 41 ...
 $ Educacion                 : int  11 15 11 11 16 10 12 9 13 19 ...
 $ Balance                   : int  333 903 580 964 331 1151 203 872 279 1350 ...
 $ Genero_Femenino           : int  0 1 0 1 0 0 1 0 1 1 ...
 $ Genero_Masculino          : int  1 0 1 0 1 1 0 1 0 0 ...
 $ Estudiante_No             : int  1 0 1 1 1 1 1 1 1 0 ...
 $ Estudiante_Si             : int  0 1 0 0 0 0 0 0 0 1 ...
 $ Casado_0                  : int  0 0 1 1 0 1 1 1 1 0 ...
 $ Casado_1                  : int  1 1 0 0 1 0 0 0 0 1 ...
 $ Etnicidad_Afrodescendiente: int  0 0 0 0 0 0 1 0 0 1 ...
 $ Etnicidad_Asiatico        : int  0 1 1 1 0 0 0 1 0 0 ...
 $ Etnicidad_Caucasico       : int  1 0 0 0 1 1 0 0 1 0 ...
numero.predictoras <- dim(datos)[2] - 1
filas <- dim(datos)[1] 
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]

1. Ejecute un modelo de regresión con SVM con todos los kernels disponibles e interprete las medidas de error del mejor de esos modelos.

Linear

library(traineR)

modelo.linear <- train.svm(Balance~., data = taprendizaje, kernel = "linear")
prediccion.linear <- predict(modelo.linear, ttesting)

linear <- indices.precision(ttesting$Balance ,prediccion.linear$prediction,numero.predictoras)
linear
$error.cuadratico
[1] 10662.37

$raiz.error.cuadratico
[1] 115.4468

$error.relativo
[1] 0.1236179

$correlacion
[1] 0.977489

Polynomial

modelo.polynomial <- train.svm(Balance~., data = taprendizaje, kernel = "polynomial")
prediccion.polynomial <- predict(modelo.polynomial, ttesting)

polynomial <- indices.precision(ttesting$Balance ,prediccion.polynomial$prediction,numero.predictoras)
polynomial
$error.cuadratico
[1] 31556.26

$raiz.error.cuadratico
[1] 198.6085

$error.relativo
[1] 0.2611754

$correlacion
[1] 0.9284669

Radial

modelo.radial <- train.svm(Balance~., data = taprendizaje, kernel = "radial")
prediccion.radial <- predict(modelo.radial, ttesting)

radial <- indices.precision(ttesting$Balance ,prediccion.radial$prediction,numero.predictoras)
radial
$error.cuadratico
[1] 17492.44

$raiz.error.cuadratico
[1] 147.87

$error.relativo
[1] 0.1593441

$correlacion
[1] 0.9623942

Sigmoid

modelo.sigmoid <- train.svm(Balance~., data = taprendizaje, kernel = "sigmoid")
prediccion.sigmoid <- predict(modelo.sigmoid, ttesting)

sigmoid <- indices.precision(ttesting$Balance ,prediccion.sigmoid$prediction,numero.predictoras)
sigmoid
$error.cuadratico
[1] 597056.4

$raiz.error.cuadratico
[1] 863.8985

$error.relativo
[1] 0.8695962

$correlacion
[1] 0.2631352

El mejor resultado lo obtuvo radial, con una correlación de 98.4% y un error en promedio de 12%. Em promedio se equivocó por 95.35.

2. ¿Qué observa en los gráficos de dispersión que muestra los valores reales contra la predicción de cada modelo? ¿Qué desventajas o ventajas puede observar en cada modelo? Explique.

Linear

library(ggplot2)
g <- plot.real.prediccion(ttesting$Balance, prediccion.linear$prediction , modelo = "SVM - Linear")

g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)

polynomial

g <- plot.real.prediccion(ttesting$Balance, prediccion.polynomial$prediction , modelo = "SVM - Polynomial")

g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)

radial

g <- plot.real.prediccion(ttesting$Balance, prediccion.radial$prediction , modelo = "SVM - Radial")

g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)

Sigmoid

g <- plot.real.prediccion(ttesting$Balance, prediccion.sigmoid$prediction , modelo = "SVM - Sigmoid")

g + geom_smooth(method = lm, size = 0.4, color = "red", se = FALSE)

Se oberva que para casi todos los núcleos excepto Sigmoid los valores reales se alinean bastante bien al modelo, el núcleo linear es el que mejor ajusta, aunque los valores iguales a cero reales variarion un poco.

3. Corra un modelo de redes neuronales usando 2 capas ocultas con 4 y 3 neuronas respectivamente. Ajuste los parámetros hasta que el modelo alcance convergencia (puede iniciar con umbral de detención como 0.05 y número de iteraciones de 50000).

library(neuralnet)
library(traineR)
numero.predictoras <- dim(datos)[2] - 1

# Calcula el modelo usando solo los datos de training
# Se deben guardar las medias y las desviaciones
medias <- sapply(taprendizaje, mean) 
desviaciones <- sapply(taprendizaje, sd)
# Se estandarizan los datos, esto se debe hacer de training y testing
taprendizaje.e  <- as.data.frame(scale(taprendizaje, center = medias, scale = desviaciones))
ttesting.e <- as.data.frame(scale(ttesting, center = medias, scale = desviaciones))
# Generamos la fórmula
nombres <- colnames(taprendizaje.e)
formula <- as.formula(paste("Balance ~", paste(nombres[!nombres %in% c("Balance")], collapse = " + ")))
# Generamos modelo. No acepta la notación lpsa~.
# Los parámetros a modificar son hidden, threshold y stepmax
# hidden = c(6, 4, 3) => 3 capas ocultas una con 6 neuronas; otra con 4 neuronas y otra con 3 neuronas
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(4,3), linear.output = TRUE, threshold = 0.05, stepmax = 50000) 
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)

# Predicción
# Primero se obtiene la predicción estandarizada
prediccion.nnet2 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result
# Luego se calcula la predicción final "des-estandarizando" los resultados
prediccion.nnet2 <- prediccion.nnet2 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices1 <- indices.precision(ttesting$Balance, prediccion.nnet2,numero.predictoras)
indices1
$error.cuadratico
[1] 357.5161

$raiz.error.cuadratico
[1] 21.1399

$error.relativo
[1] 0.02517663

$correlacion
[1] 0.9991921

4. La selección anterior no garantiza que sea la mejor. Intente 2 configuraciones de capas ocultas usando 2 capas y las neuronas que guste siempre y cuando no sean más de 10. Muestre los resultados e interprete los errores de la mejor ¿Alguna de estas configuraciones mejora la configuración del inciso anterior?

modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(4,2), linear.output = TRUE, threshold = 0.05, stepmax = 50000) 
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)

# Predicción
prediccion.nnet3 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result

prediccion.nnet3 <- prediccion.nnet3 * desviaciones["Balance"] + medias["Balance"]

# Medición de precisión
indices3 <- indices.precision(ttesting$Balance, prediccion.nnet3,numero.predictoras)
indices3
$error.cuadratico
[1] 184.9494

$raiz.error.cuadratico
[1] 15.20483

$error.relativo
[1] 0.01929812

$correlacion
[1] 0.999571
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(6,3), linear.output = TRUE, threshold = 0.05, stepmax = 50000) 
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)

# Predicción

prediccion.nnet4 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result

prediccion.nnet4 <- prediccion.nnet4 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices4 <- indices.precision(ttesting$Balance, prediccion.nnet4,numero.predictoras)
indices4
$error.cuadratico
[1] 214.3593

$raiz.error.cuadratico
[1] 16.36915

$error.relativo
[1] 0.02059658

$correlacion
[1] 0.9995021

Ambas mejoran al aumentar la cantidad de neuronas dentro de la red.

5. Intente 2 configuraciones de capas ocultas usando 3 capas y las neuronas que guste siempre y cuando no sean más de 10. Muestre los resultados e interprete los errores de la mejor ¿Alguna de estas 2 configuraciones mejora la configuración del segundo y tercer inciso?

modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(8,4,2), linear.output = TRUE, threshold = 0.05, stepmax = 50000) 
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)

# Predicción

prediccion.nnet5 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result

prediccion.nnet5 <- prediccion.nnet5 * desviaciones["Balance"] + medias["Balance"]

indices5 <- indices.precision(ttesting$Balance, prediccion.nnet5,numero.predictoras)



indices5
$error.cuadratico
[1] 4401.601

$raiz.error.cuadratico
[1] 74.17547

$error.relativo
[1] 0.05611189

$correlacion
[1] 0.9905228
modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(9,6,3), linear.output = TRUE, threshold = 0.05, stepmax = 50000) 
# Plotea la red
plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)

# Predicción

prediccion.nnet6 <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Balance")])$net.result

prediccion.nnet6 <- prediccion.nnet6 * desviaciones["Balance"] + medias["Balance"]
# Medición de precisión
indices6 <- indices.precision(ttesting$Balance, prediccion.nnet6,numero.predictoras)

indices6
$error.cuadratico
[1] 1017.688

$raiz.error.cuadratico
[1] 35.66666

$error.relativo
[1] 0.04394823

$correlacion
[1] 0.9977232

Ambas son buenas predicciones aunque disminuye su correlación en comparación a la configuración de solo 2 capas.

6. Compare los resultados anteriores con los de las tareas anteriores. ¿Cúal es el mejor método para esta tabla de datos?

library(dplyr)

errores <- rbind(as.data.frame(linear),as.data.frame(polynomial),as.data.frame(radial),as.data.frame(sigmoid),as.data.frame(indices4))


rownames(errores) <- c("SVM.linear"," SVM.polynomial","SVM.radial","SVM.sigmoid", "NeuralNet 2 capas")

errores
errores %>%
filter(raiz.error.cuadratico == min(errores$raiz.error.cuadratico))

Tomando como referencia el error cuadrático medio, el mejor modelo fue el de NeuralNet con dos capas de 6 y 3 neuronas.

El promedio de los errores fue 582.98.

La correlación fue de 97.83% la cual es bastante alta, incluso más alta que con el modelo de Regresión Múltiple de la tarea antes que fue de 99.89%.

En promedio el modelo se equivocó en un 2,96%.

Pregunta 3: [10 puntos] Un cliente nos contrata esta vez para aplicar un modelo no paramétrico con el fin de estudiar una posible oportunidad de negocio, y para ver si le es rentable quiere una predicción de las ventas potenciales de asientos de niños para autos en su tienda. Para ello nos proporciona la tabla de datos AsientosNinno.csv que contiene detalles de ventas de asientos de niños para auto en una serie de tiendas similares a las del cliente, y además los datos incluyen variables que definen caracter´ısticas de la tienda y su localidad. La tabla de datos está formada por 400 filas y 13 columnas. Seguidamente se explican las variables que conforman la tabla.

Cargue la tabla de datos en R y no elimine los NA. En caso de ser necesario, recodificar las variables de forma adecuada. Para medir el error tome un 20 % de la tabla de datos. Realice lo siguiente:

datos <- read.table("../datos/AsientosNinno.csv", dec = ".", sep = ";",header = T, stringsAsFactors = T)[,-1]
datos$CalidadEstant <- factor(datos$CalidadEstant,levels = c("Malo","Medio","Bueno"), ordered=TRUE)
str(datos)
'data.frame':   400 obs. of  13 variables:
 $ Ventas       : num  9.5 11.22 10.06 7.4 4.15 ...
 $ PrecioCompt  : int  138 111 113 117 141 124 115 136 132 132 ...
 $ Ingreso      : int  73 48 35 100 64 113 105 81 110 113 ...
 $ CercaniaEsc  : num  0.635 0.7 0.518 1.032 0.623 ...
 $ Publicidad   : int  11 16 10 4 3 13 0 15 0 0 ...
 $ Poblacion    : int  276 260 269 466 340 501 45 425 108 131 ...
 $ Precio       : int  120 83 80 97 128 72 108 120 124 124 ...
 $ CalidadEstant: Ord.factor w/ 3 levels "Malo"<"Medio"<..: 1 3 2 2 1 1 2 3 2 2 ...
 $ Edad         : int  42 65 59 55 38 78 71 67 76 76 ...
 $ Educacion    : int  17 10 12 14 13 16 15 10 10 17 ...
 $ Urbano       : int  1 1 1 1 1 0 1 1 0 0 ...
 $ USA          : int  1 1 1 1 0 1 0 1 0 1 ...
 $ Desarrollo   : num  1.074 0.101 0.335 0.491 0.319 ...
datos <- dummy_cols(datos, select_columns = c("CalidadEstant"),remove_selected_columns = T)

numero.predictoras <- dim(datos)[2] - 1
filas <- dim(datos)[1] 
muestra <- sample(1:filas, floor(filas*0.20))
ttesting <- datos[muestra,]
taprendizaje <- datos[-muestra,]


#elimino las variables
taprendizaje <- taprendizaje[,-c(4,13)]
ttesting <- ttesting[,-c(4,13)]

1. Compare en esta tabla de datos todos los métodos de regresión estudiados hasta ahora en el curso ¿Cuál modelo prefiere? Justifique sus respuestas.

Linear

library(traineR)

modelo.linear <- train.svm(Ventas~., data = taprendizaje, kernel = "linear")
prediccion.linear <- predict(modelo.linear, ttesting)

linear <- indices.precision(ttesting$Ventas ,prediccion.linear$prediction,numero.predictoras)
linear
$error.cuadratico
[1] 0.9657302

$raiz.error.cuadratico
[1] 1.090225

$error.relativo
[1] 0.1128421

$correlacion
[1] 0.9393117

Polynomial

modelo.polynomial <- train.svm(Ventas~., data = taprendizaje, kernel = "polynomial")
prediccion.polynomial <- predict(modelo.polynomial, ttesting)

polynomial <- indices.precision(ttesting$Ventas ,prediccion.polynomial$prediction,numero.predictoras)
polynomial
$error.cuadratico
[1] 2.582904

$raiz.error.cuadratico
[1] 1.782963

$error.relativo
[1] 0.1821303

$correlacion
[1] 0.8312323

Radial

modelo.radial <- train.svm(Ventas~., data = taprendizaje, kernel = "radial")
prediccion.radial <- predict(modelo.radial, ttesting)

radial <- indices.precision(ttesting$Ventas ,prediccion.radial$prediction,numero.predictoras)
radial
$error.cuadratico
[1] 1.897467

$raiz.error.cuadratico
[1] 1.528183

$error.relativo
[1] 0.1542402

$correlacion
[1] 0.8800029

Sigmoid

modelo.sigmoid <- train.svm(Ventas~., data = taprendizaje, kernel = "sigmoid")
prediccion.sigmoid <- predict(modelo.sigmoid, ttesting)

sigmoid <- indices.precision(ttesting$Ventas ,prediccion.sigmoid$prediction,numero.predictoras)
sigmoid
$error.cuadratico
[1] 6.222045

$raiz.error.cuadratico
[1] 2.767291

$error.relativo
[1] 0.2741508

$correlacion
[1] 0.7030724

NeuralNet

library(neuralnet)
library(traineR)

numero.predictoras <- dim(datos)[2] - 1

# Calcula el modelo usando solo los datos de training
# Se deben guardar las medias y las desviaciones
medias <- sapply(taprendizaje, mean) 
desviaciones <- sapply(taprendizaje, sd)
# Se estandarizan los datos, esto se debe hacer de training y testing
taprendizaje.e  <- as.data.frame(scale(taprendizaje, center = medias, scale = desviaciones))
ttesting.e <- as.data.frame(scale(ttesting, center = medias, scale = desviaciones))
# Generamos la fórmula
nombres <- colnames(taprendizaje.e)
formula <- as.formula(paste("Ventas ~", paste(nombres[!nombres %in% c("Ventas")], collapse = " + ")))


modelo.red <- neuralnet(formula, data = taprendizaje.e, hidden = c(4,2), linear.output = TRUE, threshold = 0.05, stepmax = 50000) 
# Plotea la red

plot(modelo.red, rep = "best", col.entry = "red", col.out = "green", arrow.length = 0.2)

# Predicción
# Primero se obtiene la predicción estandarizada
prediccion.nnet <- neuralnet::compute(modelo.red, ttesting.e[, -which(colnames(ttesting.e) == "Ventas")])$net.result
# Luego se calcula la predicción final "des-estandarizando" los resultados
prediccion.nnet <- prediccion.nnet * desviaciones["Ventas"] + medias["Ventas"]
# Medición de precisión
NNET <- indices.precision(ttesting$Ventas, prediccion.nnet,numero.predictoras)
NNET
$error.cuadratico
[1] 1.550542

$raiz.error.cuadratico
[1] 1.381434

$error.relativo
[1] 0.1443091

$correlacion
[1] 0.9034559
errores <- rbind(as.data.frame(linear),as.data.frame(polynomial),as.data.frame(radial),as.data.frame(sigmoid),as.data.frame(NNET))


rownames(errores) <- c("SVM.linear"," SVM.polynomial","SVM.radial","SVM.sigmoid", "NeuralNet")

errores
errores %>%
filter(raiz.error.cuadratico == min(errores$raiz.error.cuadratico))

Tomando como referencia el error cuadrático medio, el mejor modelo fue SVM con núcleo linear.

El promedio de los errores fue 0.87.

La correlación fue de 97.83% la cual es bastante alta, incluso más alta que con el modelo de Regresión Múltiple de la tarea antes que fue de 97.12%.

En promedio el modelo se equivocó en un 10%

Pregunta 4

Puede observar los puntos con el siguiente código: library ( p l o t l y ) datos <− data.frame ( x = c ( 1 , 1 , 1 , 3 , 1 , 3 , 1 , 3 , 1 ) , y = c ( 0 , 0 , 1 , 1 , 1 , 2 , 2 , 2 , 1 ) , z = c ( 1 , 2 , 2 , 4 , 3 , 3 , 1 , 1 , 0 ) , c l a s e = c ( ”Rojo” , ”Rojo” , ”Rojo” , ”Rojo” , ”Rojo” , ”Azul” , ”Azul” , ”Azul” , ”Azul” ) )

plot_ly (data = datos ) %> % add trace ( x = ˜x , y = ˜y , z = ˜z , c o l o r = ˜ cl a s e , colors = c ( ”#0C4B8E” , ”#BF382A” ) , mode = ” markers ” , type = ” s c a t t e r 3 d ” )

Realice lo siguiente:

1. Dibuje con colores los puntos de ambas clases en \(\mathbb{R}^3\)

library(plotly)
Datos <- data.frame ( x = c(1 , 1 , 1 , 3 , 1 , 3 , 1 , 3 , 1) ,y = c(0 , 0 , 1 , 1 , 1 , 2 , 2 , 2 , 1) , z = c(1 , 2 , 2 , 4 , 3 , 3 , 1 , 1 , 0) ,clase = c(" Rojo ", " Rojo ", " Rojo "," Rojo ", " Rojo ", " Azul "," Azul ", " Azul ", " Azul ")) 
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d")

2. Dibuje el hiperplano óptimo de separación e indique la ecuación de dicho hiperplano de la forma \(ax + by + cz + d = 0\). Nota: Se debe observar con detenimiento los puntos de ambas clases para encontrar los vectores de soporte de cada margen y trazar con estos puntos los

hiperplanos de los márgenes luego trazar el hiperplano de soporte justo en el centro.

Datos2 <- data.frame ( x = c(1 , 1 , 3 ) ,y = c(0 , 1 , 1 ) , z = c(1 , 2 , 4 )) 
Datos3 <- data.frame ( x = c(1 , 1 , 3 ) ,y = c(1 , 2 , 2 ) , z = c(0 , 1 , 3 )) 
Datos4<-data.frame ( x = c(1 , 1 , 3 ) ,y = c(0.5 , 1.5 , 1.5 ) , z = c(0.5 , 1.5 , 3.5 ))

plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d") %>% add_trace(data = Datos2, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d",showlegend=FALSE) %>% add_trace(data = Datos3, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d" ,   showlegend=FALSE) %>% add_trace(data = Datos4, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d" ,   showlegend=FALSE)

3. Escriba la regla de clasificación para el clasificador con margen máximo. Debe ser algo como lo siguiente: \(w = (w1, w2, w3)\) se clasifica como Rojo si \(ax + by + cz + d > 0\) y otro caso se clasifica como Azul.

  • \(w = (w1, w2, w3)\) se clasifica como Rojo si \(2x + 2y - 2z - 2\) > 0, en cualquier otro caso seria Azul.

4. Indique el margen para el hiperplano óptimo y los vectores de soporte.

library(pracma)
vector.cross <- function(a, b) {
    return (cross(a,b))
}

p<-c(1 , 0.5 , 0.5) 
q<- c(1 , 1.5 , 1.5 ) 
r<-c(3 , 1.5 , 3.5 )
pq<-q-p
pr<-r-p

vector.cross(pq, pr) 
[1]  2  2 -2
#El margen para el hiperplano optimo es de 1.
#Los vectores de soporte serian:
vector1 <- cross(c(1 , 1 , 3 ) , c(0 , 1 , 1 ))
vector1
[1] -2 -1  1
vector2 <- cross(c(1 , 2 , 2 )  , c(0 , 1 , 3 ))
vector2
[1]  4 -3  1

5. Explique por qué un ligero movimiento de la octava observación no afectaría el hiperplano de margen máximo.

Por que ese punto no fue utilizado para sacar el hiperplano óptimo por lo cual no afectaría.

6. Dibuje un hiperplano que no es el hiperplano óptimo de separación y proporcione la ecuación para este hiperplano.

Datos4<-data.frame ( x = c(1 , 1 , 3 ) ,y = c(0 , 1 , 1 ) , z = c(0.5 , 1.5 , 3.5 )) 
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d") %>% add_trace(data = Datos2, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d",showlegend=FALSE) %>% add_trace(data = Datos3, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d" ,   showlegend=FALSE) %>% add_trace(data = Datos4, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d" ,   showlegend=FALSE) 
p<-c(1 , 0 , 0.5 )
q<- c(1, 1 , 1.5 ) 
r<-c(3 , 1 , 3.5 )
pq<-q-p
pr<-r-q

vector.cross(pq, pr) 
[1]  2  2 -2

7. Dibuje un hiperplano de separación pero que no es el hiperplano óptimo de separación, y escriba la ecuación correspondiente.

Datos4<-data.frame ( x = c(0 , 0 , 2 ) ,y = c( 0.1, 1.1 , 1.1 ) , z = c(0.5 , 1.5 , 3.5 )) 
plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d") %>% add_trace(data = Datos2, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d",showlegend=FALSE) %>% add_trace(data = Datos3, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d" ,   showlegend=FALSE) %>% add_trace(data = Datos4, x = ~x , y = ~y , z = ~z ,  mode = 'lines', type = "scatter3d" ,   showlegend=FALSE) 
p<-c(0 , 0.1 , 0.5 )
q<- c( 0, 1.1 , 1.5 ) 
r<-c(2 , 1.1 , 3.5 )
pq<-q-p
pr<-r-p
vector.cross(pq, pr)
[1]  2  2 -2

8. Dibuje una observación adicional de manera que las dos clases ya no sean separables por un hiperplano.

Datos <- data.frame ( x = c(1 , 1 , 1 , 3 , 1 , 3 , 1 , 3 , 1, 2) ,y = c(0 , 0 , 1 , 1 , 1 , 2 , 2 , 2 , 1, 4) , z = c(1 , 2 , 2 , 4 , 3 , 3 , 1 , 1 , 0, 2) ,clase = c(" Rojo ", " Rojo ", " Rojo "," Rojo ", " Rojo ", " Azul "," Azul ", " Azul ", " Azul "," Rojo ")) 

plot_ly(data = Datos) %>% add_trace ( x = ~x , y = ~y , z = ~z , color = ~clase , colors = c("#0C4B8E", "#BF382A") , mode = "markers", type = "scatter3d")

Pregunta 5: [20 puntos] Pruebe que si la función objetivo a minimizar es:

\[ f(w) = \dfrac{||w||^2}{2} + C\Big(\sum _{i=1}^{n}\xi_i \Big)^2, \] donde \(C\) es un parámetro del modelo, entonces Lagrangiano Dual para la Máquina Vectorial de Soporte lineal con datos no separables es:

\[ L_D = \sum _{i=1}^{n} \lambda_i - \dfrac{1}{2}\sum_{i,j} \lambda_i \lambda_jy_iy_jx_i\cdot x_j - C\Big(\sum _{i=1}^{n}\xi_i \Big)^2. \]

Construyendo el Lagrangiano y basandonos en la diapositiva 42 tenemos:

\[ L_p = \dfrac{||w||^2}{2} + C\Big(\sum _{i=1}^{n}\xi_i \Big)^2 - \sum_{i=1}^{n} \lambda_i(y_i(w_ix_i+b)-1+\epsilon_i) - \sum_{i=1}^{n} \mu_i\epsilon_i \] Derivando:

\(\dfrac{\partial L_p}{\partial w_i} = w_j - \sum_{i=1}^{N} \lambda_i y_ix_{ij} = 0 \Rightarrow w_j = \sum_{i=1}^{N} \lambda_i y_ix_{ij}\)

\(\dfrac{\partial L_p}{\partial b} = - \sum_{i=1}^{N} \lambda_iy_i = 0 \Rightarrow \sum_{i=1}^{N} \lambda_iy_i = 0\)

\(\dfrac{\partial L_p}{\partial \epsilon_i} = C - \lambda_i \mu_i =0 \Rightarrow \lambda_i + \mu_i = C\)

De esta forma en \(L_p\):

\[\begin{align*} L_p &= \dfrac{1}{2} \sum_{i,j=1}^{n} \lambda_i\lambda_jy_iy_jx_ix_j + C(\sum_{i=1}^{n}\xi_i)^2 \\ & -\sum_{i=1}^{n}\lambda_i (y_i(\sum_{j=1}^{n} \lambda_j\lambda_j y_j x_i x_j + b) - 1 + \epsilon_i) \\ & - \sum_{i=1}^{n}(2C\sum_{i=1}^{n}\epsilon_i - \lambda_i) \\ \epsilon_j \\ &= \dfrac{1}{2} \sum_{i=1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j + C (\sum_{i=1}^{n}\epsilon_i)^2-\sum_{i,j = 1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j \\ & - \sum_{i=1}^{n} \lambda_i y_i \sum_{j=1}^{n} b_j + \sum_{i=1}^{n} \lambda_i - \sum_{i=1}^{n} \lambda_i y_i \epsilon_i - 2C(\sum_{i=1}^{n}\epsilon_i)^2 + \sum_{i=1}^{n} \lambda_i y_i \epsilon_i \\ & = \sum_{i=1}^{n} \lambda_i - \dfrac{1}{2} \sum_{i=1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j - C(\sum_{i=1}^{n}\xi_i)^2 - nb \sum_{i=1}^{n} \lambda_i y_i \end{align*}\]

Y como \(\sum_{i=1}^{n} \lambda_i y_i = 0\), tenemos:

\[ L_D = \sum_{i=1}^{n} \lambda_i - \dfrac{1}{2} \sum_{i,j =1}^{n} \lambda_i \lambda_j y_i y_j x_i x_j - C(\sum_{i=1}^{n} \xi_i)^2 \]

Pregunta 6: [10 puntos] Represente en un grafo dirigido la Red Neuronal que tiene la siguiente entrada:

\[ \vec{x} = \begin{pmatrix} 2 \\ 3 \\ -1 \\ 2 \end{pmatrix} \] Tiene la siguientes matrices de pesos

\[ W_{1} = \begin{pmatrix} 2 & 3 & 0 & 1 \\ 4 & 3 & 2 & 0 \\ 1 & 1 & 1 & 2 \\ \end{pmatrix}, \quad W_{2} = \begin{pmatrix} 1 & 7 & 1 \\ 7 & 1 & 4 \\ \end{pmatrix} \]

Tiene el siguiente bías \[ \vec{b} = \begin{pmatrix} -6 \\ -2 \end{pmatrix} \]

Además, use la siguiente función de activación en todas las neuronas:

\[ g(x) = \dfrac{1}{1+e^{-x}} \]

\[\begin{align*} y &= g(W_1 \cdot\vec{x}) = g \Bigg(\begin{pmatrix} 2 & 3 & 0 & 1 \\ 4 & 3 & 2 & 0 \\ 1 & 1 & 1 & 2 \\ \end{pmatrix} \begin{pmatrix} 2 \\ 3 \\ -1 \\ 2 \end{pmatrix} \Bigg) = g \begin{pmatrix} 15 \\ 15 \\ 8 \end{pmatrix} = \begin{pmatrix} 0.9999 \\ 0.9999 \\ 0.9996 \end{pmatrix} \\ z &= g(W_2 \cdot\vec{y} + \vec{b}) = g \Bigg( \begin{pmatrix} 1 & 7 & 1 \\ 7 & 1 & 4 \\ \end{pmatrix} \begin{pmatrix} 0.9999 \\ 0.9999 \\ 0.9996 \end{pmatrix} + \begin{pmatrix} -6 \\ -2 \end{pmatrix} \Bigg) = g \Bigg( \begin{pmatrix} \dfrac{22497}{2500} \\ \dfrac{14997}{1250} \end{pmatrix} + \begin{pmatrix} -6 \\ -2 \end{pmatrix} \Bigg) \\ z &= \begin{pmatrix} 2.9987 \\ 9.9976 \end{pmatrix} \end{align*}\]

Pregunta 7: [no usar traineR, nnet ni neuralnet] [20 puntos] Para la Tabla de Datos que se muestra seguidamente donde \(x^j\) para \(j = 1, 2, 3\) son las variables predictoras y la variable a

predecir es \(z\) diseñe una Red Neuronal de una capa (Perceptron):

Es decir, encuentre todos los posibles pesos \(x_1,w_2,w_3\) y umbrales \(\theta\) para la Red Neuronal que se muestra en el siguiente gráfico:

Use una función de activación tipo \(tanh(x)\), es decir:

\[f(x) = \tanh(x) = \dfrac{e^{x} - e^{-x}}{e^{x} + e^{-x}}\] Para esto escriba una Clase en Python que incluya los métodos necesarios pra implementar esta Red Neuronal. Se deben hacer variar los pesos \(w_j\) con \(j = 1,2,3\) en los siguientes valores v=(-1,-0.9,-0.8,...,0,...,0.8,0.9,1) y haga variar θ en u=(0,0.1,...,0.8,0.9,1). Escoja los pesos \(w_j\) con \(j = 1, 2, 3\) y el umbral θ de manera que se minimiza el error cuadrático medio:

\[E(w_1,w_2,w_3) = \dfrac{1}{4} \sum_{i=1}^{4}\Big[ I\Big[ f\Big(\sum_{j=1}^{3}w_j \cdot x_{i}^{j} - θ \Big)\Big] - z_i\Big]^2 \]

donde \(x_i^j\) es la entrada en la fila \(i\) de la variable \(x^j\) e \(I(z)\) se define como sigue:

\[ I(t) = \begin{cases} 1 & \text{si $t \geq 0$} \\ 0 & \text{si $t < 0$} \end{cases} \]

x1 <- c(1,1,1,1)
x2 <- c(0,0,1,1)
x3 <- c(0,1,0,1)
z <- c(1,1,1,0)


tabla <- data.frame(x1,x2,x3,z)

#función de activación
tangenteHiperb <- function(x){
  
  y <- 2/(1+exp(-2*x)) - 1
  
  return(y)
} 

I <- function(t){
  if(t >= 0){
    return(1)
  }else {
    return(0)
  }
}

#Pesos
v <- seq(-1,1,0.1)
u <- seq(0,1,0.1) 

error <- data.frame()
  
  
  
for (omega in u) {
  for (w1 in v) {
    for (w2 in v) {
      for (w3 in v) {
        s <- 0
        for (i in 1:4) {
          
          s <- s + (I(tangenteHiperb(w1*tabla[i,1] - omega + w2*tabla[i,2] - omega + w3*tabla[i,3] - omega)) - tabla[i,4])^2
        }
        
        error <- rbind(error,data.frame(w1,w2,w3,omega,s/4))
      }  
    }
    }
  }

Pesos y umbral que minimizan el error

names(error)[5] <- c("Error")

error%>%filter(Error == 0)

Pregunta 8: [10 puntos] Usando el algoritmo del Descenso de Gradiente encuentre “a mano” un mínimo local de la siguiente función en el intervalo \([−1, 4]\), use el punto de partida que considere adecuados. Luego grafique y verifique los resultados con código R.

\[ f(x) = 3x^4 - 16x^3 + 18x^2 \]

  • “A mano” Tome \(x_0\) y note que \(f'(x) = 12x^3 - 48x^2 + 36x\)

Paso 1

\(f(x_0) = 3(2)^4 - 16(2)^3 +18(2)^2 = -8\)

Paso 2

$f’(x_0) = f’(2) = -24 $

Paso 3

Tomanto \(\eta = 0.05\)

\(x_1 = x_0 - \eta \cdot f'(x_0) = 2 - 0.05 \cdot -24 = 3.2\)

\(\Rightarrow f(x_1) = f(3.2)= -25.3952\)

Tenemos el par \((3.2,-25.3952)\)

  • En R
library(ggplot2)
funcion <- function(x){
  3 * x^4 -16 * x^3 + 18 * x^2
}

t1 <- c(-5.0,5.0,0.1)

x = 2.0
y = funcion(x)

ggplot()+
  xlim(-5.0,5.0)+
  ylim(-45,45)+ 
  geom_function(fun = funcion)+
  geom_point(aes(x=x,y=y), colour = "red")+
  theme_minimal()

derivada <- function(x){
  12*x^3 - 48*x^2 + 36*x
}

pendiente <- derivada(x)
pendiente
[1] -24
eta = 0.05

x[2]<- x - eta*pendiente
x
[1] 2.0 3.2
y[2] <- funcion(x[2])
y
[1]  -8.0000 -25.3952
ggplot()+
  xlim(-1.0,5.0)+
  ylim(-45,45)+ 
  geom_function(fun = funcion)+
  geom_point(aes(x=x,y=y), colour = "red")+
  theme_minimal()

Pregunta 9: [10 puntos] Usando el algoritmo del Descenso de Gradiente encuentre “a mano” el mínimo global de la siguiente función, use un punto de partida que considere adecuado. Luego grafique y verifique los resultados con código R.

\[ f(x,y) = x^2 + y^2 -2x-6y+14 \]

Note que \(f_x(x,y) = 2x -2\) y \(f_y(x,y)= 2y -6\)

\(\nabla f = \begin{bmatrix} 2x - 2 \\ 2y -6 \end{bmatrix}\)

Sea $x_0 = \[\begin{bmatrix} -5 \\ 5 \end{bmatrix}\]

. $ Entonces $f(x_0) = 44 $

Tomando \(\eta = 0.1\)

\(x_1 = x_0 - \eta \cdot f'(x_0) = \begin{bmatrix} -5 \\ 5 \end{bmatrix} - 0.1 \cdot \begin{bmatrix} -12 \\ 4 \end{bmatrix} = \begin{bmatrix} -3.8 \\ 4.6 \end{bmatrix}\)

\(\Rightarrow f(x_1) = f\Big(\begin{bmatrix} -3.8 \\ 4.6 \end{bmatrix}\Big)= -29.5999\)

library(dplyr)
library(plotly)
library(pracma)

funcion <- function(x,y){
  x^2 + y^2 - 2*x - 6*y + 14
}


x = -5
y = 5

x0 = c(x,y)
x0
[1] -5  5
fx0 <- funcion(x,y)
fx0
[1] 44
gradiente <- function(x,y){
  c(2*x -2 , 2*y -6)
}

gradiente_f <- gradiente(-5,5) 
gradiente_f
[1] -12   4
eta = 0.1
x1 = x0 - eta * gradiente(-5,5)

x1
[1] -3.8  4.6
z = funcion(x1[1],x1[2])
z
[1] 29.6
xi = c(x,y)


for(i in c(1,2)){
  xi = xi -eta * gradiente(xi[1],xi[2])
  
  x = append(x,xi[1])
  
  y= append(y,xi[2])

  z = append(z, funcion(xi[1],xi[2]))
}


datos = data.frame(X=x,Y=y,Z=z)
datos
xdata = seq(-10,10,by=0.1)
ydata = seq(-10,10,by= 0.1)
  
data = meshgrid(xdata,ydata)
  
X = data$X
Y = data$Y



Z =  X^2 +  Y^2 - 2*X - 6*Y + 14


plot_ly(x = X, y = Y, z = Z)%>%
  add_surface()%>%
  add_trace(datos,type = "scatter3d", mode="markers", x =
              ~x, y = ~y, z = ~z)
datos

Ejercicio 10: [5 puntos] Usando el algoritmo del Descenso de Gradiente encuentre “a mano” un mínimo local de la siguiente función, use el punto de partida que considere adecuados. Luego grafique y verifique los resultados con código Python.

\[ f(x,y) = x^4 + y^4 -4xy+1 \]

  • A mano

Note que \(f_x(x,y) = 4x^3 -4y\) y \(f_y(x,y)= 4y^3 -4x\)

\(\nabla f = \begin{bmatrix} 4x^3 - 4y \\ 4y^3 - 4x \end{bmatrix}\)

Sea $x_0 = \[\begin{bmatrix} -0.5 \\ 0.5 \end{bmatrix}\]

. $ Entonces $f(x_0) = 2.125 $

Tomando \(\eta = 0.1\)

\(x_1 = x_0 - \eta \cdot f'(x_0) = \begin{bmatrix} -0.5 \\ 0.5 \end{bmatrix} - 0.1 \cdot \begin{bmatrix} -2.5 \\ 2.5 \end{bmatrix} = \begin{bmatrix} -0.25 \\ 0.25 \end{bmatrix}\)

\(\Rightarrow f(x_1) = f\Big(\begin{bmatrix} -0.25 \\ 0.25 \end{bmatrix}\Big)= 1.2578\)

funcion <- function(x,y){
  x^4 + y^4 - 4*x*y + 1
}


x = -0.5
y = 0.5

x0 = c(x,y)
x0
[1] -0.5  0.5
fx0 <- funcion(x,y)
fx0
[1] 2.125
gradiente <- function(x,y){
  c(4*x^3 - 4*y , 4*y^3 - 4*x)
}

gradiente_f <- gradiente(x,y) 
gradiente_f
[1] -2.5  2.5
eta = 0.1
x1 = x0 - eta * gradiente(x,y)

x1
[1] -0.25  0.25
z = funcion(x1[1],x1[2])
z
[1] 1.257812
xi = c(x,y)


for(i in c(1,2)){
  xi = xi -eta * gradiente(xi[1],xi[2])
  
  x = append(x,xi[1])
  
  y= append(y,xi[2])

  z = append(z, funcion(xi[1],xi[2]))
}


datos = data.frame(X=x,Y=y,Z=z)
datos
xdata = seq(-10,10,by=0.1)
ydata = seq(-10,10,by= 0.1)


data = meshgrid(xdata,ydata)  
  
X = data$X
Y = data$Y



Z =  X^4 +  Y^4 - 4*X*Y + 1


plot_ly(x = X, y = Y, z = Z)%>%
  add_surface()%>%
  add_trace(datos,type = "scatter3d", mode="markers", x =
              ~x, y = ~y, z = ~z)